#lang clotho
(require xsmith
         xsmith/racr-convenience
         racr
         racket/dict
         racket/list
         racket/string)
 
(define-spec-component PLDEMO) ; 定义一个语法组件 arith


; 随机产生 布尔数
(define (pick-bool)
  (random-ref (list #t #f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; 添加语法规范
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(add-to-grammar
 PLDEMO

 ;; 基类 节点
 [Node #f () #:prop may-be-generated #f] 
 ;; 表达式节点
 [Expression Node () #:prop may-be-generated #f]
 ;; 语句节点
 [Statement  Node () #:prop may-be-generated #f]
 ; 定义节点
 [Definition Node (name type) #:prop may-be-generated #f  #:prop binder-info ()]
 
 ;; 整数值节点
 [LiteralInt  Expression ([v = (random -100 100)])] ; 语法节点 父类类型  子节点信息  其他属性
 ;; 布尔值节点
 [LiteralBool Expression ([v = (pick-bool)])]
 
 ;; 变量定义节点
 [VarDecl Definition (Expression) #:prop binder-info ()
                                  #:prop choice-weight (λ (n) (if (or (ast-subtype? (parent-node n) 'Block)
                                                                      (ast-subtype? (parent-node n) 'ProgramWithBlock))
                                                               35 0))] ; 只在Block子节点 或 ProgramWithBlock节点 中出现
 ;; 上面只是 变量定义
 ;; 还有 参数定义 和  函数定义  等
 
 
 ;; 变量使用 引用
 [VariableReference Expression (name)    #:prop reference-info (read)]
 
 ;; 数学运算节点
 [ArithOp Expression ([l : Expression]  [r : Expression])  #:prop may-be-generated #f]
 
 [AddOp ArithOp()]
 [SubOp ArithOp()]
 [MulOp ArithOp()]
 [DivOp ArithOp()]
 [FloorDivOp ArithOp ()]
 [ModOp ArithOp ()]
 ;; 比较运算
 [LessThan ArithOp ()]
 [GreaterThan ArithOp()]

 ;; 变量赋值语句 name = Expression
 [AssignStmt Statement (name Expression)
                   #:prop reference-info (write)
                   #:prop choice-weight (λ (n) (if (ast-subtype? (parent-node n) 'Block) 50 0))] ; 只在Block子节点中出现
 
 ;; 语句块
 [Block Statement (;[test : Expression]
                   [testAsmt : AssignStmt ]
                   ;[testAsmt : VarDecl ]
                   [definitions : VarDecl *]
                   [statements  : Statement * = (add1 (random 5))])
                   #:prop strict-child-order? #t;顺序固定
                   #:prop choice-weight (λ (n)
                                (if (or (ast-subtype? (parent-node n) 'Block)
                                        (ast-subtype? (parent-node n) 'ProgramWithBlock))
                                 10 0)) ; 只在Block子节点 或 ProgramWithBlock节点 中出现 
        ]

#|
 [IfStatement Statement
              ([test : Expression]    ; 测试 条件 表达式
               [then : Block])        ; if 语句体
               #:prop strict-child-order? #t
               #:prop choice-weight (λ (n) (if (ast-subtype? (parent-node n) 'Block) 15 0))
              ]
 [IfElseStatement IfStatement
               ([else : Block])       ; 条件不成立 执行 分支 语句体
               #:prop strict-child-order? #t
               #:prop choice-weight (λ (n) (if (ast-subtype? (parent-node n) 'Block) 15 0))
              ]
 |#
 
 [IfStatement Block ()  #:prop strict-child-order? #t ]
 
 #|   ;完美复刻 报错 replace-hole: All choices for filling in a XsmithAstHoleStatement hole were filtered out
 [IfStatement Statement ([test : Expression]
                         [definitions : VarDecl *]
                         [statements  : Statement * = (add1 (random 3))])
                         #:prop strict-child-order? #t;顺序固定
                         #:prop choice-weight (λ (n)
                                (if (or (ast-subtype? (parent-node n) 'Block)
                                        (ast-subtype? (parent-node n) 'ProgramWithBlock))
                                 10 0)) ; 只在Block子节点 或 ProgramWithBlock节点 中出现 
        ]
 |#
 ; 包含 Block  报错 replace-hole: All choices for filling in a XsmithAstHoleStatement hole were filtered out
 ; [IfStatement Block ([test : Expression]) ]; test 在 definitions statements 之后了, test使用的变量可能在之后出现
              ;(;[test : Expression]    ; 测试 条件 表达式
              ; [then : Block])         ;语句体
              ;#:prop strict-child-order? #t
              ; #:prop choice-weight (λ (n) (if (ast-subtype? (parent-node n) 'Block) 15 0))
              ;]


 ;; 程序入口节点
 [ProgramWithBlock Node ([definitions : VarDecl *]
                         [Block])
                     #:prop strict-child-order? #t]
 
 )



(define (fresh-concrete-var-type)
  (concretize-type (fresh-type-variable))) ;; 变量 初始化类型
(add-property
 PLDEMO
 fresh
 [VarDecl
  (hash 'name (fresh-var-name "local_")    ;;; 初始化名设置 为啥没效果 !!!!!
        'type (fresh-concrete-var-type))]
 )


(define (no-increase)
  (λ (n) 0))

(add-property
  PLDEMO
  depth-increase
  [ProgramWithBlock  (no-increase)]
  [VarDecl           (no-increase)]
  [VariableReference (no-increase)]
  [AssignStmt  (no-increase)]
  [LiteralInt  (no-increase)]
  [LiteralBool (no-increase)]
  [Block       (no-increase)]
  
  #|
  [Block (λ (n) (if (member (node-type (parent-node n)) '(IfElseStatement IfStatement)); block 在父节点 内 深度+1
                    (add1 (att-value 'xsmith_ast-depth (parent-node n))) ; 父节点深度+1
                    (att-value 'xsmith_ast-depth (parent-node n))))]  ; 返回父节点深度
  |#
  ;[Block (λ (n) (att-value 'xsmith_ast-depth (parent-node n)))]  ; 返回父节点深度 类似于 不加深度??
 #|
 [IfStatement (λ (n) (if (member (node-type (parent-node n)) '(IfElseStatement IfStatement))
                   (add1 (att-value 'xsmith_ast-depth (parent-node n)))
                   
                   (if (member (node-type (parent-node n)) '(ProgramWithBlock ))
                     1
                     (if (member (node-type (parent-node n)) '(Block ))
                      (add1 (att-value 'xsmith_ast-depth (parent-node (parent-node n))));父节点Block的父节点深度 + 1
                      (att-value 'xsmith_ast-depth (parent-node n))))
                   
                   ))]
 |#

  
 )

; 一个是表达式 嵌套调用深度
; 一个是 语句 嵌套深度

#|
;; 较大影响代码生成  嵌套深度等
;; 节点深度不增加
(define (no-increase)
  (λ (n) 0))

(add-property
 PLDEMO
 depth-increase           ; 语句嵌套顺序 属性          
 [ProgramWithBlock (no-increase)]
 [VarDecl (no-increase)]
 [AssignStmt (no-increase)]
 [Expression (no-increase)]
 [Block (λ (n) (if (member (node-type (parent-node n)) '(IfElseStatement IfStatement)); block 在父节点 内 深度+1
                   (add1 (att-value 'xsmith_ast-depth (parent-node n))) ; 父节点深度+1
                   (att-value 'xsmith_ast-depth (parent-node n))))]  ; 返回父节点深度

 [IfStatement (λ (n) (if (member (node-type (parent-node n)) '(IfElseStatement IfStatement))
                   (add1 (att-value 'xsmith_ast-depth (parent-node n)))
                   (att-value 'xsmith_ast-depth (parent-node n))))]
 )
|#


;; 类型提升
(add-property
 PLDEMO
 lift-predicate
 [ProgramWithBlock (λ (n t) #t)]
 [Block (λ (n t) (and (not (function-type? t))
                      (not (nominal-record-definition-type? t))))]
 )


;; 定义绑定信息
;;lift-type->ast-binder-type: You must specify a #f value for the lift-type->ast-binder-type property if your language has more than one binding form
(add-property
 PLDEMO
 lift-type->ast-binder-type
 [#f (λ (t) (cond
              [(function-type? t) 'FuncDecl]
              [else 'VarDecl]))]
 )


;;; 节点深度不会过于深 
(add-property
 PLDEMO
 wont-over-deepen
 [VarDecl #t]
 [AssignStmt #t]
 ;[Block #t]
 ;[ValReturnStmt #t]
 )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; 配置类型信息
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define int (base-type 'int)); 目前 仅支持 一种类型 integer
(define bool (base-type 'bool)); 目前 仅支持 一种类型 integer
(define (usable-types)
  (fresh-type-variable int bool))
(define Expression (base-type 'Expression))
(define Definition (base-type 'Definition))

(define (no-child-types)  (λ (n t) (hash))) ;无子节点 返回空hash函数


(define no-return-type (base-type 'no-return-type))
;; Statement types
(define-generic-type return-type (type))
(define (fresh-maybe-return-type)
  (fresh-type-variable (return-type (fresh-type-variable))  no-return-type))


; 二元操作 子节点类型映射 和父节点类型不相关  使用指定的类型
(define (numeric-bin-op/no-relation-to-return number-type)
  (λ (n t) (hash 'l number-type 'r number-type)))

; 二元操作 子节点类型映射 和父节点相关的类型  使用父节点类型 t 作为子节点的要求
(define numeric-bin-op-subtype
  (λ (n t)
    (hash 'l t 'r t)))


(add-property
 PLDEMO
 type-info

 ;; 整数值节点
 [LiteralInt [int no-child-types]]; 节点类型为 int  无子节点 返回空hash函数
 [LiteralBool [bool no-child-types]]; 节点类型为 int  无子节点 返回空hash函数
 
 ;; 变量定义节点
 [VarDecl [(fresh-type-variable) (λ (n t) (hash 'Expression (fresh-type-variable)))]]; 会有 bool值 (usable-types)
 
 ;; 变量引用节点
 [VariableReference [(fresh-type-variable) no-child-types]]

 ;; 数学运算节点
 [AddOp      [(fresh-type-variable int) numeric-bin-op-subtype]]   ; [节点为int   子节点Expression 类型 也为 int ]
 [SubOp      [(fresh-type-variable int) numeric-bin-op-subtype]]   ; 左右操作数 类型  均为  int  类型函数 返回一个类型映射字典
 [MulOp      [(fresh-type-variable int) numeric-bin-op-subtype]]
 [DivOp      [(fresh-type-variable int) numeric-bin-op-subtype]]
 [FloorDivOp [(fresh-type-variable int) numeric-bin-op-subtype]]
 [ModOp      [(fresh-type-variable int) numeric-bin-op-subtype]]
 
 [LessThan    [bool (numeric-bin-op/no-relation-to-return int)]]
 [GreaterThan [bool (numeric-bin-op/no-relation-to-return int)]]

 ;; 赋值表达式
 [AssignStmt [(fresh-type-variable) (λ (n t) (hash 'Expression (fresh-type-variable) ))]]


 ;; if控制语句
 [IfStatement [(fresh-type-variable)
               (λ (n t) (hash
                         ;'test bool
                         'testAsmt bool
                         ;'testAsmt (fresh-type-variable)
                         'definitions (λ (c) (fresh-type-variable))
                         'statements  (λ (cn)  (fresh-type-variable))
                         ;'temp bool
                         ))]]
 #|
 ;; if-else控制语句
 [IfElseStatement [(fresh-type-variable)
                     (λ (n t) (hash 'test bool
                                    'then (λ (c) (fresh-type-variable))
                                    'else (λ (c) (fresh-type-variable))  ))]]
 |#
 
 ;; 语句块
 [Block [ (fresh-type-variable)
            (λ (n t) (hash
                      ;'test bool
                      'testAsmt bool
                      'definitions (λ (cn)  (fresh-type-variable))
                      'statements  (λ (cn)  (fresh-type-variable))) )]]

 #|
  [Block [(fresh-type-variable)
          (λ (n t)
           (define stmts (ast-children (ast-child 'statements n)))
           (define last-stmt (car (reverse stmts)));;; 最后一个语句
           (define stmt-dict
             (for/hash ([s stmts])
               (values s
                       (if (eq? s last-stmt)
                           t
                           (fresh-type-variable))))); 最后一个语句又返回
           (for/fold ([dict stmt-dict])
                     ([d (ast-children (ast-child 'definitions n))])
             (dict-set dict d (fresh-type-variable))))]]
  |#
  

 [ProgramWithBlock [no-return-type
                      (λ (n t)
                        (hash 'definitions (λ (c) (fresh-type-variable))
                              'Block       (λ (c) (fresh-type-variable))))
                   ]]

 
 )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; 配置程序输出格式
;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (binary-op-renderer op-rendered)
  (λ (n) (format "(~a ~a ~a)" 
                 (att-value 'xsmith_render-node (ast-child 'l n))
                 op-rendered
                 (att-value 'xsmith_render-node (ast-child 'r n)))))


(define (binary-op-renderer_safe safe_func)
  (λ (n) (format "~a(~a, ~a)"
                 safe_func
                 (att-value 'xsmith_render-node (ast-child 'l n))
                 (att-value 'xsmith_render-node (ast-child 'r n)))))


(define (block-subnode-renderer block subnode [head ""])
 (string-join
     (map (λ (x) (format "~a~a" head x))
      (map (λ (cn) (att-value 'xsmith_render-node cn))
           (ast-children (ast-child subnode block)))) "\n"))

(define (block-definitions-renderer block [head ""])
  (block-subnode-renderer block 'definitions head))

(define (block-statements-renderer block [head ""])
  (block-subnode-renderer block 'statements head))

(define (block-renderer block [head ""])
  (string-append
    (block-definitions-renderer block head)
    "\n"
    (block-statements-renderer block head)))



(define runtime_safegard
"
import numpy as np

###### runtime safe func #######

def save_div(a, b):
    if (b == 0):
        return a
    return a/b

def save_floor_div(a, b):
    if (b == 0):
        return a
    return a//b

def save_mod(a, b):
    if (b == 0):
        return a
    return a%b

###### random code  #########
"
)


(add-property
 PLDEMO
 render-node-info

 ;; 整数节点打印格式
 [LiteralInt (λ (n) (number->string (ast-child 'v n)))];  n 为 当前 AST节点 LiteralInt类型节点
 ;; 布尔数节点打印格式
 [LiteralBool (λ (n) (if (ast-child 'v n) "True" "False"))]; 布尔字符
 
 ;; 数学运算节点打印格式
 [AddOp (binary-op-renderer "+")]
 [SubOp (binary-op-renderer "-")]
 [MulOp (binary-op-renderer "*")]
 [DivOp (binary-op-renderer_safe "save_div")]       
 [FloorDivOp (binary-op-renderer_safe "save_floor_div")]  
 [ModOp (binary-op-renderer_safe "save_mod")]
 
 [LessThan    (binary-op-renderer "<")]
 [GreaterThan (binary-op-renderer ">")]
 
 [VariableReference (λ (n) (format "(~a)" (ast-child 'name n)))]
 [VarDecl (λ (n) (format "~a = ~a";   decl dep: ~a "
                         (ast-child 'name n)
                         (att-value 'xsmith_render-node (ast-child 'Expression n))
                         ;(att-value 'xsmith_ast-depth n)
                         ))]
 
 ;; 赋值运算节点打印格式
 [AssignStmt
  (λ (n) (format "~a = ~a";  asmt dep: ~a"
                 (ast-child 'name n)
                 (att-value 'xsmith_render-node (ast-child 'Expression n))
                 ;(att-value 'xsmith_ast-depth n)
                 ))]

  ;; if 控制语句
 [IfStatement
  (λ (n)
    ;(define test (ast-child 'test n))
    (define testAsmt (ast-child 'testAsmt n))
    ;(define tb (ast-child 'then n))
    (define node_dp (att-value 'xsmith_ast-depth n))
    (define dp_tab (string-join (make-list node_dp "    ")))
    (define if_dp (if (> node_dp 1) (- node_dp 1) 0))
    (define if_dp_tab (if (> if_dp 0) (string-join (make-list if_dp "    ")) ""))
    (string-append
     ;;; TODO 考虑 代码块缩进
     "\n"
     ;(format "~a~a\n" if_dp_tab (att-value 'xsmith_render-node testAsmt)) ;;;; 条件表达式会用到后面的变量???
     (format "~atry:\n" if_dp_tab)
     (format "~a~a\n" dp_tab (att-value 'xsmith_render-node testAsmt))
     (format "~aexcept:\n" if_dp_tab)
     (format "~a~a = ~a\n" dp_tab (ast-child 'name testAsmt) (random-ref (list "True" "False")))
     
     (format "~aif(~a): \n" if_dp_tab (ast-child 'name testAsmt))
     ;(format "if(~a): \n" (att-value 'xsmith_render-node test))
     ; "------if():\n"
     (block-renderer n dp_tab)
     #|
     (format "\n-------if end nt:~a nd:~a pnt:~a pnd:~a\n"
                      (node-type n)
                      (att-value 'xsmith_ast-depth n)
                      (node-type (parent-node n))
                      (att-value 'xsmith_ast-depth (parent-node n))
                      )
     |#
     ))
  ]

 #|
 ;; if-else 控制语句
 [IfElseStatement
  (λ (n)
    (define test (ast-child 'test n))
    (define tb (ast-child 'then n))
    (define eb (ast-child 'else n))
    (string-append
     ;;; TODO 考虑 代码块缩进
     (format "if(~a): \n" (att-value 'xsmith_render-node test))
     (att-value 'xsmith_render-node tb)  ;递归调用子节点的打印方法 (block-renderer tb)
     "\nelse:\n"
     (att-value 'xsmith_render-node eb)  ;递归调用子节点的打印方法  (block-renderer eb)
     "\n"
     )
    )]
|#

 ;; 语句块
 [Block  (λ (n)
             (define node_dp (att-value 'xsmith_ast-depth (parent-node n))); 使用父节点的深度
             (define dp_tab (string-join (make-list node_dp "    ")))
             (define dp_tab_1 (string-join (make-list (+ node_dp 1) "    ")))
             (define testAsmt (ast-child 'testAsmt n))
             (string-append
              "\n" ; 避免多级 tab 串联打印
              ;(format "~a~a\n" dp_tab (att-value 'xsmith_render-node testAsmt))
              (format "~atry:\n" dp_tab)
              (format "~a~a\n" dp_tab_1 (att-value 'xsmith_render-node testAsmt))
              (format "~aexcept:\n" dp_tab)
              (format "~a~a = ~a\n" dp_tab_1 (ast-child 'name testAsmt) (random-ref (list "True" "False")))
              (block-renderer n dp_tab)
              ;"\n"
              #|
              (format "\n nt:~a pd:~a pnt:~a pbd:~a \n"
                      (node-type n)
                      (att-value 'xsmith_ast-depth n)
                      (node-type (parent-node n))
                      (att-value 'xsmith_ast-depth (parent-node n))
               )
               |#
              ) )]

 ;; 程序
 [ProgramWithBlock
    (λ (n)
      (define definitions (ast-children (ast-child 'definitions n)))
      (define pb (ast-child 'Block n))
      ;; 打印代码
      (string-append
       runtime_safegard ;;; 运行时 安全保护代码
       "\n"
       (block-definitions-renderer n)
       "\n"
       (att-value 'xsmith_render-node pb)  ;递归调用子节点的打印方法 (block-renderer pb)
       "\n\n\n####### print data to check #######\n\n"
       ;;;; 打印定义变量的值
       (string-join
            (map (λ (v) (format "print(~a)" (ast-child 'name v)))
                 (filter (λ (x) (base-type? (ast-child 'type x)))
                         definitions))
            "\n")
       )
      )
  ]
  
)




(define concretized-types
  (map (λ (t) (λ () t))
       (list int bool)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 组合程序
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This line defines `PLDEMO-command-line`.
(define-xsmith-interface-functions
  [PLDEMO]
  ;#:default-max-depth 8
  ;;; 程序头注释 格式化方法
  #:comment-wrap (λ (lines)
                   (string-join
                    (map (λ (x) (format "#  ~a" x)) lines)
                    "\n")); 注释 格式化打印
  ; 程序入口节点 
  #:program-node ProgramWithBlock 
  #:type-thunks concretized-types
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; 启动程序构建
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module+ main (PLDEMO-command-line))

